home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FPCBIN.LZH / BANNER.SEQ next >
Text File  |  1988-08-15  |  5KB  |  107 lines
  1. \ BANNER.SEQ    Compliments of F83X   mod to sequential by Tom Zimmer
  2.  
  3. CREATE CHAR-MATRIX              \ build the character generator
  4. HEX (  ) 00 C, 00 C, 00 C, 00 C, 00 C, 00 C, 00 C, 00 C,
  5.     ( !) 20 C, 20 C, 20 C, 20 C, 20 C, 00 C, 20 C, 00 C,
  6.     ( ") 50 C, 50 C, 50 C, 00 C, 00 C, 00 C, 00 C, 00 C,
  7.     ( #) 50 C, 50 C, F8 C, 50 C, F8 C, 50 C, 50 C, 00 C,
  8.     ( $) 20 C, 78 C, A0 C, 70 C, 28 C, F0 C, 20 C, 00 C,
  9.     ( %) C0 C, C8 C, 10 C, 20 C, 40 C, 98 C, 18 C, 00 C,
  10.     ( &) 40 C, A0 C, A0 C, 40 C, A8 C, 90 C, 68 C, 00 C,
  11.     ( ') 30 C, 30 C, 10 C, 20 C, 00 C, 00 C, 00 C, 00 C,
  12.     ( () 20 C, 40 C, 80 C, 80 C, 80 C, 40 C, 20 C, 00 C,
  13.     (  ) 20 C, 10 C, 08 C, 08 C, 08 C, 10 C, 20 C, 00 C,
  14.     ( *) 20 C, a8 C, 70 C, 20 C, 70 C, a8 C, 20 C, 00 C,
  15.     ( +) 00 C, 20 C, 20 C, 70 C, 20 C, 20 C, 00 C, 00 C,
  16.     ( ,) 00 C, 00 C, 00 C, 30 C, 30 C, 10 C, 20 C, 00 C,
  17.     ( -) 00 C, 00 C, 00 C, 70 C, 00 C, 00 C, 00 C, 00 C,
  18.     ( .) 00 C, 00 C, 00 C, 00 C, 00 C, 30 C, 30 C, 00 C,
  19.     ( /) 00 C, 08 C, 10 C, 20 C, 40 C, 80 C, 00 C, 00 C,
  20.     ( 0) 70 C, 88 C, 98 C, A8 C, C8 C, 88 C, 70 C, 00 C,
  21.     ( 1) 20 C, 60 C, 20 C, 20 C, 20 C, 20 C, 70 C, 00 C,
  22.     ( 2) 70 C, 88 C, 08 C, 30 C, 40 C, 80 C, F8 C, 00 C,
  23.     ( 3) F8 C, 10 C, 20 C, 30 C, 08 C, 88 C, 70 C, 00 C,
  24.     ( 4) 10 C, 30 C, 50 C, 90 C, F8 C, 10 C, 10 C, 00 C,
  25.     ( 5) F8 C, 80 C, F0 C, 08 C, 08 C, 88 C, 70 C, 00 C,
  26.     ( 6) 38 C, 40 C, 80 C, F0 C, 88 C, 88 C, 70 C, 00 C,
  27.     ( 7) F8 C, 08 C, 10 C, 20 C, 40 C, 40 C, 40 C, 00 C,
  28.     ( 8) 70 C, 88 C, 88 C, 70 C, 88 C, 88 C, 70 C, 00 C,
  29.     ( 9) 70 C, 88 C, 88 C, 78 C, 08 C, 10 C, E0 C, 00 C,
  30.     ( :) 00 C, 60 C, 60 C, 00 C, 60 C, 60 C, 00 C, 00 C,
  31.     ( ;) 00 C, 60 C, 60 C, 00 C, 60 C, 60 C, 40 C, 00 C,
  32.     ( <) 10 C, 20 C, 40 C, 80 C, 40 C, 20 C, 10 C, 00 C,
  33.     ( =) 00 C, 00 C, F8 C, 00 C, F8 C, 00 C, 00 C, 00 C,
  34.     ( >) 40 C, 20 C, 10 C, 08 C, 10 C, 20 C, 40 C, 00 C,
  35.     ( ?) 70 C, 88 C, 10 C, 20 C, 20 C, 00 C, 20 C, 00 C,
  36.     ( @) 70 C, 88 C, A8 C, B8 C, B0 C, 80 C, 78 C, 00 C,
  37.     ( A) 20 C, 70 C, 88 C, 88 C, F8 C, 88 C, 88 C, 00 C,
  38.     ( B) F0 C, 88 C, 88 C, F0 C, 88 C, 88 C, F0 C, 00 C,
  39.     ( C) 70 C, 88 C, 80 C, 80 C, 80 C, 88 C, 70 C, 00 C,
  40.     ( D) F0 C, 48 C, 48 C, 48 C, 48 C, 48 C, F0 C, 00 C,
  41.     ( E) F8 C, 80 C, 80 C, F0 C, 80 C, 80 C, F8 C, 00 C,
  42.     ( F) F8 C, 80 C, 80 C, F0 C, 80 C, 80 C, 80 C, 00 C,
  43.     ( G) 78 C, 80 C, 80 C, 80 C, 98 C, 88 C, 78 C, 00 C,
  44.     ( H) 88 C, 88 C, 88 C, F8 C, 88 C, 88 C, 88 C, 00 C,
  45.     ( I) 70 C, 20 C, 20 C, 20 C, 20 C, 20 C, 70 C, 00 C,
  46.     ( J) 08 C, 08 C, 08 C, 08 C, 08 C, 88 C, 78 C, 00 C,
  47.     ( K) 88 C, 90 C, A0 C, C0 C, A0 C, 90 C, 88 C, 00 C,
  48.     ( L) 80 C, 80 C, 80 C, 80 C, 80 C, 80 C, F8 C, 00 C,
  49.     ( M) 88 C, D8 C, A8 C, A8 C, 88 C, 88 C, 88 C, 00 C,
  50.     ( N) 88 C, 88 C, C8 C, A8 C, 98 C, 88 C, 88 C, 00 C,
  51.     ( O) 70 C, 88 C, 88 C, 88 C, 88 C, 88 C, 70 C, 00 C,
  52.     ( P) F0 C, 88 C, 88 C, F0 C, 80 C, 80 C, 80 C, 00 C,
  53.     ( Q) 70 C, 88 C, 88 C, 88 C, A8 C, 90 C, 68 C, 00 C,
  54.     ( R) F0 C, 88 C, 88 C, F0 C, A0 C, 90 C, 88 C, 00 C,
  55.     ( S) 70 C, 88 C, 80 C, 70 C, 08 C, 88 C, 70 C, 00 C,
  56.     ( T) F8 C, 20 C, 20 C, 20 C, 20 C, 20 C, 20 C, 00 C,
  57.     ( U) 88 C, 88 C, 88 C, 88 C, 88 C, 88 C, 70 C, 00 C,
  58.     ( V) 88 C, 88 C, 88 C, 88 C, 88 C, 50 C, 20 C, 00 C,
  59.     ( W) 88 C, 88 C, 88 C, A8 C, A8 C, D8 C, 88 C, 00 C,
  60.     ( X) 88 C, 88 C, 50 C, 20 C, 50 C, 88 C, 88 C, 00 C,
  61.     ( Y) 88 C, 88 C, 50 C, 20 C, 20 C, 20 C, 20 C, 00 C,
  62.     ( Z) F8 C, 08 C, 10 C, 20 C, 40 C, 80 C, F8 C, 00 C,
  63.     ( [) 78 C, 40 C, 40 C, 40 C, 40 C, 40 C, 78 C, 00 C,
  64.     ( \) 00 C, 80 C, 40 C, 20 C, 10 C, 08 C, 00 C, 00 C,
  65.     ( ]) F0 C, 10 C, 10 C, 10 C, 10 C, 10 C, F0 C, 00 C,
  66.     ( ^) 00 C, 00 C, 20 C, 50 C, 88 C, 00 C, 00 C, 00 C,
  67.     ( _) 00 C, 00 C, 00 C, 00 C, 00 C, 00 C, 00 C, F8 C,
  68.  
  69. DECIMAL
  70.  
  71. CREATE BITS     ( --- a1 )
  72.                 128 C, 64 C, 32 C, 16 C, 8 C, 4 C, 2 C, 1 C,
  73.  
  74. : BIT           ( N1 --- F1 )
  75.                 BITS + C@ AND 0= 1+ ;
  76.  
  77.  
  78.  
  79. : LC>UC         ( c -- )
  80.                 DUP 96 128 WITHIN   32 AND - ;
  81.  
  82. : BANNER        ( a n -- )
  83.                 BOUNDS   8 0
  84.                 DO      CR      2DUP
  85.                        ?DO      I C@    127 AND LC>UC   32 -
  86.                                 8*      CHAR-MATRIX +   J + C@
  87.                                 7 0
  88.                                 DO      DUP I BIT
  89.                                         IF      ASCII #
  90.                                         ELSE    BL
  91.                                         THEN    EMIT
  92.                                 LOOP DROP
  93.                         LOOP
  94.                 LOOP    2DROP ;
  95.  
  96. : DEMO          ( --- )         \ print demonstration message
  97.                 DARK CR
  98.                 " WELCOME"      BANNER
  99.                 " TO F-PC"      BANNER
  100.                 2 SECONDS
  101.                 DARK CR
  102.                 " BANNER"       BANNER
  103.                 " PROGRAM"      BANNER
  104.                 " FROM F83X"    BANNER ;
  105. DEMO
  106.  
  107.